#!/usr/bin/perl
use warnings;
use strict;

use feature qw/say/;
use Carp qw(confess cluck);
use Cwd qw{abs_path    cwd};
use Data::Dumper::Concise;
use Env;
use File::Basename;
use File::Path qw (make_path);
use File::Slurp;
use FileHandle;
use FindBin qw($RealBin  $RealScript);
use Getopt::Long;
use YAML;




use lib $RealBin;

use CON;                                                                                                 
use Carp::Always::Color;                                                                                 
use Data::Printer            {indent        =>                   1};                                     
#use Math::Interpolate        qw(derivatives constant_interpolate linear_interpolate robust_interpolate); 
#use Statistics::Descriptive;                                                                             
use ZipSlurp;                                                                                            
use FlHandle;


my $opt_force = undef;
$|=1;
#


my $file_lib = q//;
my $out_dir;
my $file_pin ;

GetOptions(
    'force'      => \$opt_force,
    'lib=s'      => \$file_lib,
    'out_dir=s'  => \$out_dir,
    'pinfile=s'  => \$file_pin,
);

if(not $file_lib ){ 
    printf "%s \n", &CONm( "-E- no lib file provided ", 5);
    print_usage();
}

if (not -e $file_lib) { 
    printf "%s \n", &CONm( "-E- lib file $file_lib not exists ", 5);
    print_usage();
}

my $abs_file_pin;
my ($pinFileNameBase,$pinDir,$pinSuffix);
my %Hpin;
my @AHpinN;
if($file_pin ){
    if( not -e $file_pin) { 
        printf "%s \n", &CONm( "-E- pin list file $file_pin provided but file not exists ", 5);
        print_usage();
        exit;
    }
    $abs_file_pin = abs_path($file_pin);
    ($pinFileNameBase,$pinDir,$pinSuffix) = fileparse($abs_file_pin, qr/\.?[^.]*(\.gz)?/);
    printf "-i-reading pinlist file:%8s\n", &CONm(" $abs_file_pin");
    my $PinString = q//;
    &readZF( qq{$abs_file_pin}, \$PinString) ;
    @AHpinN = map{lc $_} ($PinString =~m{ [^ \t\n\(\)\{\}"]+ }sixg);
    foreach my $pi3 (@AHpinN) {
        my ( $PinN, $TimingType, $AddingValue, $ScalingFactor, $MaxMinOnly ) = split /,/, $pi3;
        my $ttype2 = lc $TimingType;
        if ($MaxMinOnly) {
            $Hpin{$PinN}{$ttype2}{$MaxMinOnly}{AddingValue}   = $AddingValue;
            $Hpin{$PinN}{$ttype2}{$MaxMinOnly}{ScalingFactor} = $ScalingFactor;
        } else {
            $Hpin{$PinN}{$ttype2}{BothMaxMin}{AddingValue}   = $AddingValue;
            $Hpin{$PinN}{$ttype2}{BothMaxMin}{ScalingFactor} = $ScalingFactor;
        }
    }



}

my $abs_file_lib = abs_path($file_lib);
my $cryp_string = qq(7b4912b580a8af3356668eb406bea703eeecc1921c8ef2105c5f02851d1891f9); # special string to tag as post-adjust
my $str_head = q//;
&FlHandle::ReadPartOfZFile( $abs_file_lib, \$str_head, 10_480);

if ( ($str_head =~m#$cryp_string#six) and not $opt_force) {
    Carp::confess "-W-already adjusted; $abs_file_lib  ...  Exiting.";
}


printf "-i-input lib file:%8s\n", &CONm(" $abs_file_lib");

# pre-defined regexp patterns 
my $ws=qr([ \t]*)six;

my $parenth_name        = qr { $ws \($ws \S+ $ws \) $ws}six;
my $parenth_only        = qr { \s* \(\s*  \)\s*}six;
my $braces              = qr{ ( \s* \{ (?: (?> [^\{\}]+ ) | (?-1) )* \}) }six;
my $parentheses         = qr{ ( \s* \( (?: (?> [^\(\)]+ ) | (?-1) )* \)) }six;
my $FloatPNumber2       = qr { -? \b \d+\.? \d* \b}six;
my $RisePat             = qr{\b (?:rise_constraint|rise_transition|cell_rise )}six;
my $FallPat             = qr{\b (?:fall_constraint|fall_transition|cell_fall )}six;
my $RisePatterns        = qr{$RisePat $parenth_name $braces}six;
my $FallPatterns        = qr{$FallPat $parenth_name $braces}six;
my $RiseFallPatterns    = qr{(?:$RisePat|$FallPat )$parenth_name $braces}six;
my $ValuesPatterns      = qr{values $parentheses}six;
my $TimingTypePattern   = qr{\b timing_type $ws : $ws (\S+)}six;
my $minDelayFlagPattern = qr{\b min_delay_flag $ws : $ws "? true "? }six;

my ($LibFileNameBase,$libDir,$suffix) = fileparse($abs_file_lib, qr/\.[^.]*(\.(?:bz2|gz))?/);
my $pin_name ;
my $libaa =q//;
&readZF($abs_file_lib, \$libaa);
my ($cellTitle, $cell_chunk) = ($libaa =~m/( cell $parenth_name) $braces/six);

$libaa =~s/(pin $parenth_name $braces)/&TreatPinBlock($1)/sixge;



my $out_file_full_name;
if ($out_dir) {
    if ( not -d $out_dir ) { make_path($out_dir) or Carp::confess "cannot create $out_dir"; }
} else {
    $out_dir = $libDir;
}
$out_dir = abs_path($out_dir);

my $rng = &GetRndHex;
$out_file_full_name = "$out_dir/$LibFileNameBase.preadj.$rng$suffix";
printf "-i-backing up to file %8s\n", &CONm( " $out_file_full_name ", 2 );

system "cp -f $abs_file_lib $out_file_full_name" and Carp::confess "cannot backup orig file $file_lib into $out_file_full_name";

$out_file_full_name = "$out_dir/$LibFileNameBase$suffix";

my $time_string_whole = localtime();
my $str_stamp         = "/* $cryp_string\n\n adjusted at  $time_string_whole.  \n using $RealBin/$RealScript \n\n";

@AHpinN = sort keys %Hpin;
my $PinListString = &YAML::Dump( \%Hpin );
$str_stamp .= "\n adjusting assertions of pins (in YAML format) : \n  $PinListString \n";

$str_stamp .= " */\n";
$libaa =~ s/^/\n$str_stamp/is;
&writeZF( \$libaa, $out_file_full_name );



#------------------------------------------------------
# 
##------------------------------------------------------
sub TreatPinBlock 
{#_{{_
    my ($pStr) = @_;
    if ( not $pStr ) { return; }

    my ($pname) = ( $pStr =~ m/pin ($parenth_name)/six );
    $pname =~ s#[" \t\(\)]##g;
    $pname = lc $pname;
    my $found_pin = 0;

    if ( $Hpin{$pname} ) {
        $pStr =~ s/(timing $parenth_only $braces)/&TreatTimingBlock($1, $pname)/sixge;
    } else {
    }
    return $pStr;

}#_}}_



sub TreatRFallBlocks 
{#_{{_
    my ($timing_type, $lk, $rH) = @_;
    $lk =~/$ValuesPatterns/; # there may be float point numbers _OUTSIDE_ value blocks;
    my $matched_values = $&; # so we cannot RegExp on the whole $lk
    my $pre_values = $`;     # only the matched_values can be adjusted; 
    my $post_values = $';    # rest of them (pre and post, sometimes liberty comments) will no change

    my $LocalAddingValue = 0;
    my $LocalScalingFactor = 1;
    if ($rH) {
        if ( $rH->{AddingValue} )   { $LocalAddingValue   = $rH->{AddingValue}; }
        if ( $rH->{ScalingFactor} ) { $LocalScalingFactor = $rH->{ScalingFactor}; }
    } else {
    }

    if ($rH ){
        if($pre_values =~/(rise|fall)_transition/){ $matched_values =~s/$FloatPNumber2/sprintf "%.1f", $&/ge; }
        else {
            $matched_values =~s/$FloatPNumber2/sprintf "%.1f", ($&+ $LocalAddingValue)*$LocalScalingFactor/ge;
        }
    }
   
    my $newlk =$pre_values.$matched_values.$post_values;
    return $newlk;

}#_}}_


sub TreatTimingBlock 
{#_{{_
    my ($StrTi, $pname) = @_;
    if (not $StrTi){ return ;}
    if ($StrTi !~m/timing $parenth_only/six){ return ;} # no content in parenthesis
    my $timing_type_in;
    ($timing_type_in) = ($StrTi =~m/$TimingTypePattern/);
    $timing_type_in //= q/no_mention_type/; 
    my $LibMinFlg = ($StrTi =~m/$minDelayFlagPattern/i);

    if ( $pname and $Hpin{$pname} and $Hpin{$pname}{$timing_type_in} ) {
        my $rH3 = $Hpin{$pname}{$timing_type_in};
        if ( $rH3->{BothMaxMin} ) {    # on both max assertion and LibMinFlg
            $StrTi =~ s/($RiseFallPatterns)/&TreatRFallBlocks($timing_type_in, $1 , $rH3->{BothMaxMin});/sixge;
        } else {
            if ($LibMinFlg) {    # this timing arc is min-delay
                my $UserMinRiseKey0 = ( grep { m/min/i and m/rise/i } sort keys %{$rH3} )[0];
                if ($UserMinRiseKey0) {
                    $StrTi =~ s/($RisePatterns)/&TreatRFallBlocks($timing_type_in, $1 , $rH3->{$UserMinRiseKey0});/sixge;
                }
                my $UserMinFallKey0 = ( grep { m/min/i and m/fall/i } sort keys %{$rH3} )[0];
                if ($UserMinFallKey0) {
                    $StrTi =~ s/($FallPatterns)/&TreatRFallBlocks($timing_type_in, $1 , $rH3->{$UserMinFallKey0});/sixge;
                }
                if ( not $UserMinRiseKey0 and not $UserMinFallKey0 ) {
                    my $UserMinKey0 = ( grep { m/min/i } sort keys %{$rH3} )[0];
                    if ($UserMinKey0) {
                        $StrTi =~ s/($RiseFallPatterns)/&TreatRFallBlocks($timing_type_in, $1 , $rH3->{$UserMinKey0});/sixge;
                    }
                }
            } else {    # not min-flag; so it's max timing
                my $UserMaxRiseKey0 = ( grep { m/max/i and m/rise/i } sort keys %{$rH3} )[0];
                if ($UserMaxRiseKey0) {
                    $StrTi =~ s/($RisePatterns)/&TreatRFallBlocks($timing_type_in, $1 , $rH3->{$UserMaxRiseKey0});/sixge;
                }
                my $UserMaxFallKey0 = ( grep { m/max/i and m/fall/i } sort keys %{$rH3} )[0];
                if ($UserMaxFallKey0) {
                    $StrTi =~ s/($FallPatterns)/&TreatRFallBlocks($timing_type_in, $1 , $rH3->{$UserMaxFallKey0});/sixge;
                }
                if ( not $UserMaxRiseKey0 and not $UserMaxFallKey0 ) {
                    my $UserMaxKey0 = ( grep { m/max/i } sort keys %{$rH3} )[0];
                    if ($UserMaxKey0) {
                        $StrTi =~ s/($RiseFallPatterns)/&TreatRFallBlocks($timing_type_in, $1 , $rH3->{$UserMaxKey0});/sixge;
                    }
                }
            }    # end of else (max timing)
        } #end of else, does mention max-min/ rise fall etc
    } else { # no mentioning pins
    }
    return $StrTi;
}#_}}_

sub print_usage
{#_{{_

  my $string0 = &CONm( "Required:", 5);
  my $string0p1 = &CONm( "$RealBin/$RealScript", 2);

my $string1  = &CONm( "pinname,TimingType,AddingValue,ScalingFactor", );
my $string2  = &CONm( "xphy_data16_signal_lane1,rising_edge,-76,1\nxphy_data16_signal_lane1,no_mention_type,-60,1" );
my $string2a = &CONm( "xphy_data16_signal_lane2,rising_edge,0,0.95,min_only", 3);
my $string2b = &CONm( "xphy_data16_signal_lane3,rising_edge,0,1.05,max_only", 4);
my $string3a = &CONm( "xphy_data16_signal_lane3,rising_edge,100,1,max_only_rise", 5);
my $string3b = &CONm( "xphy_data16_signal_lane3,rising_edge,200,1,max_only_fall", 6);
  my $ScaleHelp = <<"__EOHELP__";


#######################################################################
#                                USAGE                                #
#######################################################################


 $string0p1 -lib <lib_name> -pin <pinlist_file> -out <outdir> -force

# where

#######################
#  -lib   <lib_name>  #
#######################
      
    
# $string0 : Full path of lib file to be adjusted

#  -FYI- original file will be saved as file.preadj.random.lib 


#########################
#  -pin <pinlist_file>  #
#########################

# $string0 Full path to a file containing pin names; only
# those pins mentioned in this pin-file would be adjusted.
#
# Syntax/format is like

$string1

#    e.g., below takes away 76ps from the assertion
#    of timing_type 'rising_edge'. If (rarely) there
#    is timing assertion with _NO_ timing_type,
#    please use "no_mention_type" string in place.
#    E.g., below also takes away 60ps from tming
#    assertions with no mentioning of timing_type.

$string2

#    sometimes the min-delay timing assertions are together in the same file
#
#   timing () {
#    ...
#       min_delay_flag : true ;  /* <--- this flag */
#    ...
#    }
# 
#    if to adjust differently between min_delay and max (no
#    above min_delay_flag attribute), please use this syntax
#    as below (min_only or max_only to the 4th column; column
#    starts from zero). Below shows to scale min-delay assertions
#    by 0.95x, and to scale max-delay assertions by 1.05x.

$string2a
$string2b

#   if to even adjust differently between cell_rise/cell_fall,
#   or rise_constraint/fall_constraint, (one timing token
#   may have both cell_rise and cell_fall assertions,
#   e.g.), also to include the "rise/fall" keyword
#   in the 4th column (columns starting from zero).

$string3a
$string3b

###################
#  -out <outdir>  #
###################

# Optional: output directory; default is libfile's residing
# directory
#

############
#  -force  #
############
 
# Optional: by default we can only adjust lib file once. The top
# portion of adjusted lib file is injected with comments about
# the amount of timing values being adjusted and timestamp etc.
#
# This script dies immediately when it sees adjusted lib files.
# 
# To override this protection mechnism, -f argument allows
# us to further adjust lib file. <=== use with caution!!


__EOHELP__

say $ScaleHelp;

  exit;

}#_}}_


